The Best of MacTutor - S…e Code for Volumes 1 to 5/The Best of MacTutor - Source Code for Volume 1-5 (Wayzata Technology)(6031)(1990).bin/Source Code/#10 (Jul 86)/modula source/MakePath.MOD

Text File | 1986-04-13 | 6KB | 203 lines

(* Tom Taylor
   3707 Poinciana Dr. #137
   Santa Clara, CA  95051 *)

MODULE MakePath;

(* This program demonstrates a use of
   the PBFileManager module.
   The program puts up the SFGetFile
   dialog and allows the user to select
   a file.  The program will then print
   out the full path name to the file.
   Click the mouse to continue and
   click the SFGetFile's cancel button
   to quit. *)

  FROM PBFileManager IMPORT
    PBGetCatInfo, CInfoPBRec,
    HParamBlockRec, PBHGetVInfo;
  FROM PackageManager IMPORT
    SFGetFile, SFReply, SFTypeList;
  FROM SYSTEM IMPORT
    ADR;
  FROM MacSystemTypes IMPORT
    Str255, LongCard;
  FROM Strings IMPORT
    StrMacCat, StrModToMac;
  FROM WindowManager IMPORT
    WindowPtr, GetNewWindow,
    DisposeWindow;
  FROM QuickDraw1 IMPORT
    MoveTo, DrawString,
    SetPort, Point, TextFont;
  FROM DialogManager IMPORT
    StopAlert;
  FROM EventManager IMPORT
    StillDown, Button;

  CONST
    MFSInstalled = -1;  (* Location in low
                memory tells whether
            HFS system installed *)
    HFSvolume = 04244h; (* Value specifying a
                     HFS volume *)

  TYPE
    Str255Ptr = POINTER TO Str255;

  VAR
    reply       : SFReply;
    typelist    : SFTypeList;
    HFS [03f6h] : INTEGER;
    wind        : WindowPtr;
    behind      : LongCard;
    path        : Str255;
    where       : Point;
    hfsFlag     : BOOLEAN;

  PROCEDURE WriteString (s : ARRAY OF CHAR);
  (* This routine simply writes a Modula-2
     style string. *)
    VAR
      macs : Str255;
  BEGIN
    StrModToMac (macs,s);
    DrawString (macs);
  END WriteString;

  PROCEDURE MakePath (name : Str255Ptr;
                vRefNum : INTEGER;
              VAR path : Str255;
              VAR hfsFlag : BOOLEAN);
  (* This procedure, the focus of this
     program, takes a vRefNum (which might
     be a WDRefNum) and figures out the full
     path to the directory.  It does this
     by finding the parent each directory
     until the parent is the root.  This
     procedure works on both MFS and HFS
     Macs. *)
    VAR
      blk              : CInfoPBRec;
      volBlk           : HParamBlockRec;
      getname, volname : Str255;
      len              : CARDINAL;

    PROCEDURE CheckError (err : INTEGER);
    BEGIN
      IF err # 0 THEN
        err := StopAlert (1986, NIL);
    HALT
      END;
    END CheckError;

  BEGIN
    path    := name^; (* Start the path with
                         the destination file *)
    volname := "";    (* Clear out the volume
                         name *)
    (* Get the volume info for the desired
       volume.  This calls works on both
       HFS and MFS systems. *)
    WITH volBlk DO
      ioCompletion := NIL;
      ioNamePtr    := ADR(volname);
      ioVRefNum    := vRefNum;
      ioVolIndex   := 0;
      ioVSigWord   := 0;
      CheckError (PBHGetVInfo (ADR(volBlk), FALSE));
    END;
    (* This next line determines whether the HFS
       system is installed and whether the current
       volume is an HFS volume. *)
    hfsFlag := (HFS # MFSInstalled) AND
               (volBlk.ioVSigWord = HFSvolume);

    IF hfsFlag THEN
      (* Only attempt to build a path name
         deeper than just a volume and file
     on HFS volumes *)
      WITH blk DO
    ioCompletion := NIL;
    getname      := "";
    ioNamePtr    := ADR(getname);
    ioVRefNum    := vRefNum; (* Probably a WDRefNum *)
    ioFDirIndex  := -1;  (* directory info only *)
    ioDrDirID.r  := 0.0; (* kludge for LongCard zero *)
    CheckError (PBGetCatInfo (ADR(blk), FALSE));
    WHILE (ioDrDirID.h # 0) OR
          (ioDrDirID.l # 2) DO
      (* Keep looping until the directory ID
         is the root directory (dir ID = 2) *)

      (* Insert a colon in the path *)
      len := CARDINAL(getname[0]);
      IF len < 255 THEN
        INC(len);
        getname[len] := ':';
        getname[0] := CHAR(len);
      END;
      (* Append the path made so
         far with the piece we
         just got. *)
      StrMacCat(getname,path);

      (* Save the partial path
         in path. *)
      path := getname;

      getname := "";
      ioFDirIndex := -1;  (* directory info only *)
      ioDrDirID   := ioDrParID; (* Get info about
                                   the parent
                       directory. *)
      CheckError (PBGetCatInfo (ADR(blk), FALSE));
    END;
      END;
    END;

    (* Lastly, append the path to the volume name *)
    len := CARDINAL(volname[0]);
    INC(len);
    volname[len] := ':';
    volname[0] := CHAR(len);
    StrMacCat(volname, path);
    path := volname;
  END MakePath;

BEGIN
  behind.h := 65535; (* kludge for LongCard -1 *)
  behind.l := behind.h;
  where.h := 100;  (* location of SFGetFile *)
  where.v := 100;
  LOOP
    SFGetFile (where, "", NIL, -1, typelist, NIL, reply);
    WITH reply DO
      IF NOT good THEN EXIT END; (* Exit if user hit cancel *)

      (* Figure out path to the file *)
      MakePath (ADR(fName), vRefNum, path, hfsFlag);

      TextFont (0); (* so window title comes up right *)
      wind := GetNewWindow (1986, NIL, WindowPtr(behind));
      SetPort (wind);
      MoveTo (5,17);
      WriteString ("The path name on this ");
      IF hfsFlag THEN
        WriteString ("HFS");
      ELSE
        WriteString ("MFS");
      END;
      WriteString (" volume is:");
      MoveTo (5, 37);
      DrawString (path);
      WHILE StillDown () DO END;
      WHILE NOT Button () DO END;
      (* Really need to use GetNextEvent
         so this button press is eaten *)
      DisposeWindow (wind);
    END;
  END;
END MakePath.